perm filename SCREEN[P,JRA] blob sn#430603 filedate 1979-04-01 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(def cursor (wd) (cond ((not (vc wd) t)
C00004 00003	(def glitch (wd) (hold wd)
C00006 00004	(def prins (wd str) (prin wd str (slength str)))
C00007 00005	(def frame (wd hchr vchr cchr)
C00008 00006	(def takein (wd) (cond ((or (< ll wd)  3) (< (lc wd) 3)) (err )))
C00011 ENDMK
C⊗;
(def cursor (wd) (cond ((not (vc wd) t)
			(cm wd) (set (V(cur_add wd)) (not (V(cur_add wd)))))
			(t (set (V(cur_add wd)) (cc wd))))

(def cur_add (wd) (plus (cur_line_add wd)
		        (cc wd)))

(def cur_line_add (wd) (lin_add (cl wd) wd))

(lin_add (rel_lin wd) (plus (times (plus (sr wd) rel_lin)
				   88)
			     (sc wd)))

(def clear_lin (rel_lin wd) (cond ((fg wd) (setq chr (not blank))
				  (t (setq chr blank)))
			    (setq z (lin_add rel_lin wd))
			    (setq z1 (lc wd))
			    (while z>0
				(do (set (V z) chr)
				    (incr z)
				    (decr z1)))

(def clear_c_l (wd) (clear_lin (cl wd) wd))

(def clear (wd) (clr wd) (cursor wd))

(def clr (wd) (setq (cl wd) 0 (cc wd) 0)
	      (setq z (ll wd))
	      (while z>0
		(do (clear_lin  z wd)
		    (decr z)))

(def clearline (wd) (clear_lin wd)
		    (setq (cc wd) 0)
		    (cursor wd))

(def newline (wd) (incr (cl wd))
		  (cond ((cl wd) > (ll wd)) (glitch wd))
		  (setq (cc wd) 0)
		  (cond ((sp wd) = 0) (clear_c_l wd)))

(def glitch (wd) (hold wd)
		 (cond ((sp wd) = 0) (setq (cl wd) 0) (return))
		       ((sp wd) ≥ (add1 (ll wd)) (clr wd) (return))
		       ((fg wd) → (setq chr (not blank))
		       (t (setq chr blank)))
		 (xymove (lin_add (plus (sc wd) (sp wd)) wd)
			 (lin_add (sc wd) wd)
			 (diff (ll wd) (sp wd))
			 (add1 (lc wd))
			 chr)

(def hold (wd) (cond ((and (ho wd) (ob wd)) ((hold_proc wd) )))


(def xymove (sa da h w chr)
	(cond ((h > 0) (setq linc 88)
	      (t (setq linc -88)(setq h - h)))
	(cond ((w > 0) (setq cinc 1))
	      (t (setq cinc -1)(setq w -w)))
	(while  (h > 0)
	   (do 	(while (w >0)
		    (do	(set (V da) (V sa))
			(set (V sa) chr)
			(setq da (plus da cinc))
			(setq sa (plus da cinc))
			(decr w)))
		(decr h)
		(setq sa (plus sa linc))))

(def prins (wd str) (prin wd str (slength str)))

(def prints (wd str) (print wd str (slength str)))

(def print (wd str n) (prin wd str n)
		      (frline wd)
		      (cursor wd))

(def prin wd str n) (while (n>0)
			   (do (pri wd (first str))
			       (setq str (cdr str))
			       (decr n))))

(de pri (wd chr) (cplt wd chr)
		 (incr (cc wd))
		 (cond ((cc wd) = (lc wd)) (newline wd))

(de cplt (wd chr) (plt wd (cl wd) (cc wd) chr))

(de plt (wd line col chr)
		(set (V(plus(lin_add line wd) col)
		     (cond ((fg wd) (not chr))
			   (t chr))))

(def scroll (wd n) (setq (sp wd) n))

(def frame (wd hchr vchr cchr)
		(cond ((not (fr wd)) (setq (fr wd) t)
				     (takein wd)
				     (clr wd)))
		(frm3 (frm3 (frm3 (frm3 (add1 (lin_add 0 wd))
					88
					(ll wd)
					vchr
					cchr)
				  1
				  (lc wd)
				  hchr
				  cchr)
		      	     -88
		            (ll wd)
		            vchr
		            cchr)
			-1
			(lc wd)
			hchr
			cchr)
		(cursor wd))

(def frm3 (sa inc bndry chr cchr)
		(while (bndry >0)
			(do (set (V sa) chr)
			    (setq sa (plus sa inc))
			    (decr bndry)))
		(set (V sa) cchr)
		(ret sa))
****fencepost errors****

(def takein (wd) (cond ((or (< ll wd)  3) (< (lc wd) 3)) (err )))
		 (incr (sr wd))
		 (incr (sc wd))
		 (set (ll wd) (ll wd) -2)
		 (set (lc wd) (lc wd) -2))

(def unframe (wd) (letout wd)
		  (set (fr wd) nil)
		  (clr wd)
		  (cursor wd))

(def letout (wd) (cond((not (fr wd)) t))
		 (decr (sr wd))
		 (decr (sc wd))
		 (set (ll wd) (ll wd) - 2)
		 (set (lc wd) (lc wd) - 2))

(def labels (wd str) (label wd str (slength str))

(def label (wd str n) (cond ((or (not (fr wd)) (> (plus n 2) (lc wd))) t))
		       (setq sa (plus (diff (lin_add 0 wd)
					     89)
				      (div (diff (lc wd) 2)
					    2)))
		       (while (n > 0)
			       (do (set (V sa) (car str))
				   (incr sa)
				   (setq str (cdr str))
				   (decr n))))

(def slength (str) (setq n 0)
		   (while ((car str) ≠ '377)
			  (do (incr n)
			      (setq str (cdr str))))
		   (return n))

(def cursorch (wd chr) (cond ((fg wd) (setq chr (not chr))))
		       (set (cc wd) chr)
		       (cursor wd))
(def compl (wd) (set (fg wd) (not (fg wd)))
		(cpl0 wd))

(def cpl0 (wd) (set (cc wd) (not (cc wd)))
		(setq sa (lin_add 0 wd))
		(setq lin (ll wd))
		(while (lin > 0)
		   (do	(setq col (lc wd))
			(while (col > 0)
			    (do	(set (V sa) (not (V sa)))
				(incr sa)
				(decr col)))
			(setq sa (plus sa 88))
			(decr lin))))

(def flash (wd)	(cpl0 wd)
		(delay 40000)
		(cpl0 wd)
		(delay 40000))

(def plot (wd lin col chr)
	      (cond((or	(lin <0) 
			(col < 0)
			(lin > (ll wd))
			(col > (cl wd)) t)
		   (t (plt wd lin col chr)))

(def backspace (wd) (cplt wd " ")
		    (cond ((cc wd) ≠ 0) (decr (cc wd))
		    (cursor wd))

(def freshline (wd) (frline wd) (cursor))

(def frline (wd) (